Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH13/SRC/OBJCYLR2.CLS

Text File | 1996-04-12 | 13.5 KB | 502 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjCylinder"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

' Point1 and Point2 are points at each end of the
' cylinder's axis.
Private Point1 As Point3D
Private Point2 As Point3D
Private Radius As Single

' The axis.
Private Ax As Single
Private Ay As Single
Private Az As Single

' The radii vectors.
Private V1x As Single
Private V1y As Single
Private V1z As Single
Private V2x As Single
Private V2y As Single
Private V2z As Single

Private HitX As Single
Private HitY As Single
Private HitZ As Single
Private HitT As Single

Private Kar As Single
Private Kag As Single
Private Kab As Single

Private Kdr As Single
Private Kdg As Single
Private Kdb As Single

Private SpecN As Single
Private Ks As Single

Private Krr As Single
Private Krg As Single
Private Krb As Single

Private Nt As Single
Private N1 As Single   ' Index of refraction outside the object.
Private N2 As Single   ' Index of refraction inside the object.
Private Ktr As Single
Private Ktg As Single
Private Ktb As Single

Private IsReflective As Boolean
Private IsTransparent As Boolean

' ************************************************
' Set constants for transmitted light.
' ************************************************
Sub SetKt(n As Single, n_1 As Single, n_2 As Single, R As Single, G As Single, B As Single)
    Nt = n
    N1 = n_1
    N2 = n_2
    Ktr = R
    Ktg = G
    Ktb = B
    IsTransparent = (R > 0 Or G > 0 Or B > 0)
End Sub

' ************************************************
' Initialize N1 and N2 to default values.
' ************************************************
Private Sub Class_Initialize()
    N1 = 1
    N2 = 1
End Sub

' ************************************************
' Apply a transformation matrix to the plane.
' ************************************************
Public Sub Apply(M() As Single)
    ' Transform the points.
    m3Apply Point1.coord, M, Point1.trans
    m3Apply Point2.coord, M, Point2.trans
End Sub

' ************************************************
' Return the red, green, and blue components of
' the surface at the hit position.
' ************************************************
Public Sub HitColor(depth As Integer, Objects As Collection, R As Integer, G As Integer, B As Integer)
Dim Vx As Single
Dim Vy As Single
Dim Vz As Single
Dim nx As Single
Dim ny As Single
Dim nz As Single
Dim lx As Single
Dim ly As Single
Dim lz As Single
Dim rx As Single
Dim ry As Single
Dim rz As Single
Dim n_len As Single
Dim l_len As Single
Dim v_len As Single
Dim r_len As Single
Dim NdotL As Single
Dim RdotV As Single
Dim NdotV As Single
Dim r_dif As Single
Dim g_dif As Single
Dim b_dif As Single
Dim r_amb As Single
Dim g_amb As Single
Dim b_amb As Single
Dim spec As Single
Dim r_ref As Single
Dim g_ref As Single
Dim b_ref As Single
Dim r1 As Integer
Dim g1 As Integer
Dim b1 As Integer
Dim mx As Single
Dim my As Single
Dim mz As Single
Dim LdotV As Single
Dim r_trd As Single
Dim g_trd As Single
Dim b_trd As Single
Dim r_tra As Single
Dim g_tra As Single
Dim b_tra As Single
Dim tx As Single
Dim ty As Single
Dim tz As Single
Dim n_ratio As Single
Dim cos2 As Single
Dim cos1 As Single
Dim cos_factor As Single
Dim NdotT As Single
Dim NdotT_Nt As Single
Dim hit_x As Single
Dim hit_y As Single
Dim hit_z As Single
Dim i As Integer
Dim dist As Single
Dim shadowed As Boolean
Dim rlng As Long
Dim glng As Long
Dim blng As Long

    hit_x = HitX
    hit_y = HitY
    hit_z = HitZ

    ' *******************************
    ' * Compute local contributions *
    ' *******************************

    ' Find the unit vector pointing toward the light.
    lx = LightSource.trans(1) - HitX
    ly = LightSource.trans(2) - HitY
    lz = LightSource.trans(3) - HitZ
    l_len = Sqr(lx * lx + ly * ly + lz * lz)
    lx = lx / l_len
    ly = ly / l_len
    lz = lz / l_len
    ' We will use l_len later as the distance from
    ' the light to the surface.

    ' Find the surface unit normal.
    Vx = Point2.trans(1) - Point1.trans(1)
    Vy = Point2.trans(2) - Point1.trans(2)
    Vz = Point2.trans(3) - Point1.trans(3)
    nx = HitX - (Point1.trans(1) + HitT * Vx)
    ny = HitY - (Point1.trans(2) + HitT * Vy)
    nz = HitZ - (Point1.trans(3) + HitT * Vz)
    n_len = Sqr(nx * nx + ny * ny + nz * nz)
    nx = nx / n_len
    ny = ny / n_len
    nz = nz / n_len

    ' Find the vector V from the surface to the
    ' viewpoint.
    Vx = EyeX - HitX
    Vy = EyeY - HitY
    Vz = EyeZ - HitZ
    v_len = Sqr(Vx * Vx + Vy * Vy + Vz * Vz)
    Vx = Vx / v_len
    Vy = Vy / v_len
    Vz = Vz / v_len

    ' See if the light shines directly on the surface.
    For i = 1 To Objects.Count
        dist = Objects.Item(i).RayDistance( _
            LightSource.trans(1), _
            LightSource.trans(2), _
            LightSource.trans(3), _
            -lx, -ly, -lz)
        If dist < l_len - 0.1 Then Exit For
    Next i
    shadowed = (i <= Objects.Count)

    ' Calculate the part due to diffuse reflection.
    If shadowed Then
        ' The light does not hit the surface.
        r_dif = 0
        g_dif = 0
        b_dif = 0
        spec = 0
    Else
        ' Treat backface planes as normal planes.
        NdotL = Abs(nx * lx + ny * ly + nz * lz)

        r_dif = Kdr * NdotL
        g_dif = Kdg * NdotL
        b_dif = Kdb * NdotL

        ' Find vector R in the mirror direction.
        rx = 2 * nx * NdotL - lx
        ry = 2 * ny * NdotL - ly
        rz = 2 * nz * NdotL - lz

        ' Calculate the part due to specular reflection.
        RdotV = rx * Vx + ry * Vy + rz * Vz
        If RdotV < 0 Then
            spec = 0
        Else
            spec = Ks * RdotV ^ SpecN
        End If
    End If

    ' Calculate the part due to ambient light.
    r_amb = LightIar * Kar
    g_amb = LightIag * Kag
    b_amb = LightIab * Kab

    ' **********************************
    ' * Compute reflected contribution *
    ' **********************************
    NdotV = nx * Vx + ny * Vy + nz * Vz
    r_ref = 0
    g_ref = 0
    b_ref = 0
    If IsReflective And depth > 1 Then
        ' Find vector M in the direction of reflection.
        mx = 2 * nx * NdotV - Vx
        my = 2 * ny * NdotV - Vy
        mz = 2 * nz * NdotV - Vz

        TraceRay depth - 1, HitX, HitY, HitZ, mx, my, mz, r1, g1, b1
        r_ref = Krr * r1
        g_ref = Krg * g1
        b_ref = Krb * b1
    End If

    ' **********************************
    ' * Compute refracted contribution *
    ' **********************************
    r_trd = 0
    g_trd = 0
    b_trd = 0
    r_tra = 0
    g_tra = 0
    b_tra = 0
    If IsTransparent Then
        ' Find the transmission vector T.
        If NdotV > 0 Then
            ' The ray is entering this object.
            cos1 = NdotV
        Else
            ' The ray is exiting this object.
            cos1 = -NdotV
        End If
        n_ratio = N1 / N2
        cos2 = Sqr(1 - (1 - cos1 * cos1) * n_ratio * n_ratio)
        cos_factor = cos2 - cos1 * n_ratio
        tx = -Vx * n_ratio - cos_factor * nx
        ty = -Vy * n_ratio - cos_factor * ny
        tz = -Vz * n_ratio - cos_factor * nz

        ' If LdotV < 0, the viewpoint and light are on
        ' opposite sides of the surface. In that case
        ' there is direct transmitted light and no
        ' specular reflection.
        '
        ' If LdotV > 0, the viewpoint and light are on
        ' the same side of the surface. Then there
        ' is specular reflection and no direct
        ' transmitted light.
        LdotV = lx * Vx + ly * Vy + lz * Vz

        ' Find the directly transmitted component.
        If LdotV < 0 Then
            NdotT = nx * tx + ny * ty + nz * tz
            NdotT_Nt = NdotT ^ Nt
            r_trd = Ktr * NdotT_Nt
            g_trd = Ktg * NdotT_Nt
            b_trd = Ktb * NdotT_Nt
        End If

        ' Find the indirectly transmitted component.
        If depth > 1 Then
            TraceRay depth - 1, hit_x, hit_y, hit_z, tx, ty, tz, r1, g1, b1
            r_tra = Ktr * r1
            g_tra = Ktg * g1
            b_tra = Ktb * b1
        End If
    End If

    ' See how intense to make the color.
    ' Some of the reflections may be close to
    ' the light source so these values can get big.
    rlng = r_amb + _
        LightIir / (l_len + LightKdist) * _
            (r_dif + spec) + _
        r_ref + r_tra + r_trd
    glng = g_amb + _
        LightIig / (l_len + LightKdist) * _
            (g_dif + spec) + _
        g_ref + g_tra + g_trd
    blng = b_amb + _
        LightIib / (l_len + LightKdist) * _
            (b_dif + spec) + _
        b_ref + b_tra + b_trd
    If rlng > 255 Then rlng = 255
    If glng > 255 Then glng = 255
    If blng > 255 Then blng = 255
    R = rlng
    G = glng
    B = blng
End Sub

' ************************************************
' Compute the distance from point (x3, y3, z3)
' along vector <wx, wy, wz> to the cylinder.
'
' Save the point of intersection in
' (HitX, HitY, HitZ) for later use.
' ************************************************
Public Function RayDistance(x3 As Single, y3 As Single, z3 As Single, Wx As Single, Wy As Single, Wz As Single) As Single
Dim x1 As Single
Dim y1 As Single
Dim z1 As Single
Dim Vx As Single
Dim Vy As Single
Dim Vz As Single
Dim Vlen2 As Single
Dim WdotV As Single
Dim A As Single
Dim B As Single
Dim Cx As Single
Dim Cy As Single
Dim Cz As Single
Dim dx As Single
Dim dy As Single
Dim dz As Single
Dim A1 As Single
Dim b1 As Single
Dim C1 As Single
Dim B24AC As Single
Dim u1 As Single
Dim u2 As Single

    ' Find the axis vector.
    Vx = Point2.trans(1) - Point1.trans(1)
    Vy = Point2.trans(2) - Point1.trans(2)
    Vz = Point2.trans(3) - Point1.trans(3)

    ' Find A and B for t = A * u + B.
    Vlen2 = Vx * Vx + Vy * Vy + Vz * Vz
    WdotV = Wx * Vx + Wy * Vy + Wz * Vz
    A = WdotV / Vlen2

    x1 = Point1.trans(1)
    y1 = Point1.trans(2)
    z1 = Point1.trans(3)
    B = (Vx * (x3 - x1) + _
         Vy * (y3 - y1) + _
         Vz * (z3 - z1)) / Vlen2

    ' Solve for u.
    Cx = Wx - Vx * A
    Cy = Wy - Vy * A
    Cz = Wz - Vz * A
    dx = x3 - x1 - Vx * B
    dy = y3 - y1 - Vy * B
    dz = z3 - z1 - Vz * B
    A1 = Cx * Cx + Cy * Cy + Cz * Cz
    b1 = 2 * (Cx * dx + Cy * dy + Cz * dz)
    C1 = dx * dx + dy * dy + dz * dz - Radius * Radius
    ' Solve the quadratic A1*u^2 + B1*u + C1 = 0.
    B24AC = b1 * b1 - 4 * A1 * C1
    If B24AC < 0 Then
        RayDistance = INFINITY
        Exit Function
    ElseIf B24AC = 0 Then
        u1 = -b1 / 2 / A1
    Else
        B24AC = Sqr(B24AC)
        u1 = (-b1 + B24AC) / 2 / A1
        u2 = (-b1 - B24AC) / 2 / A1
        ' Use only positive t values.
        If u1 < 0.02 Then u1 = u2
        If u2 < 0.02 Then u2 = u1
        ' Use the smaller t value.
        If u1 > u2 Then u1 = u2
    End If

    ' If there is no positive u value, there's no
    ' intersection in this direction.
    If u1 < 0.02 Then
        RayDistance = INFINITY
        Exit Function
    End If

    ' See where on the cylinder this is.
    HitT = u1 * A + B
    ' If this is not between Point1 and Point2,
    ' ignore it.
    If HitT < 0 Or HitT > 1 Then
        RayDistance = INFINITY
        Exit Function
    End If

    ' Compute the actual hit location.
    HitX = x3 + u1 * Wx
    HitY = y3 + u1 * Wy
    HitZ = z3 + u1 * Wz

    ' Compute the distance from (x3, y3, z3).
    A1 = x3 - HitX
    b1 = y3 - HitY
    C1 = z3 - HitZ
    RayDistance = Sqr(A1 * A1 + b1 * b1 + C1 * C1)
End Function

' ************************************************
' Initialize the data.
' ************************************************
Public Sub Initialize(R As Single, p1x As Single, p1y As Single, p1z As Single, p2x As Single, p2y As Single, p2z As Single)
    Radius = R
    Point1.coord(1) = p1x
    Point1.coord(2) = p1y
    Point1.coord(3) = p1z
    Point1.coord(4) = 1
    Point2.coord(1) = p2x
    Point2.coord(2) = p2y
    Point2.coord(3) = p2z
    Point2.coord(4) = 1
End Sub


' ************************************************
' Set N and Ks for specular reflection.
' ************************************************
Sub SetSpec(n As Single, s As Single)
    SpecN = n
    Ks = s
End Sub

' ************************************************
' Return the latest Hit location.
' ************************************************
Public Sub HitLocation(x As Single, y As Single, z As Single)
    x = HitX
    y = HitY
    z = HitZ
End Sub

' ************************************************
' Set constants for diffuse reflection.
' ************************************************
Sub SetKd(R As Single, G As Single, B As Single)
    Kdr = R
    Kdg = G
    Kdb = B
End Sub

' ************************************************
' Set constants for ambient light.
' ************************************************
Sub SetKa(R As Single, G As Single, B As Single)
    Kar = R
    Kag = G
    Kab = B
End Sub
' ************************************************
' Set constants for reflected light.
' ************************************************
Sub SetKr(R As Single, G As Single, B As Single)
    Krr = R
    Krg = G
    Krb = B
    IsReflective = (R > 0 Or G > 0 Or B > 0)
End Sub